home *** CD-ROM | disk | FTP | other *** search
/ Leisure Game Pak 1 / Leisure Game Pak I.iso / lpgame1 / 04 / source / tiles.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-17  |  12KB  |  300 lines
  1. UNIT    TILES;
  2.  
  3. INTERFACE
  4.  
  5. CONST   PUSHED_TILE     = TRUE;            (* modes for drawing tiles *)
  6.         NOT_PUSHED_TILE = NOT(PUSHED_TILE);
  7.  
  8.     MAX_COL_ROW     = 50;        (*  max. no of ROWs, COLs  *)
  9.  
  10.         (*  color constants are of COLOR_TYPE  *)
  11.         BLACK        = 0;
  12.         DKGREY        = 1;
  13.         GREY        = 2;
  14.         CLR_MARKED    = 3;    (* BLUE *)
  15.         CLR_VISIBLE1     = 6;    (*  colors 6..13 are used for visible1..8  *)
  16.         CLR_VISIBLE_MINE= 14;
  17.         WHITE        = 15;    (* for mouse *)
  18.         BY_CONTENTS     = 16;   (* color depends on tile contents *)
  19.  
  20. TYPE    COLOR_TYPE    = 0..16;
  21.  
  22.         (*  the contents of a field, note that hidden9, marked9 are never
  23.         used ... they're needed to keep equal distances: 0..mine *)
  24.     CONTENTS_TYPE = (hidden0, hidden1, hidden2, hidden3, hidden4,
  25.                          hidden5, hidden6, hidden7, hidden8, hidden9,
  26.              hidden_mine,
  27.                          visible0, visible1, visible2, visible3, visible4,
  28.                          visible5, visible6, visible7, visible8, visible9,
  29.              visible_mine,
  30.                          marked0, marked1, marked2, marked3, marked4,
  31.                          marked5, marked6, marked7, marked8, marked9,
  32.              marked_mine);
  33.  
  34.         PUSH_MODE_TYPE = BOOLEAN;
  35.  
  36.     COORDS_TYPE    = RECORD
  37.                 x, y : WORD;
  38.                    END;
  39.  
  40.     SCENE_TYPE     = RECORD  (*  cols, rows are in [0..NumX-1]  *)
  41.                                 NumCols, NumRows : BYTE;
  42.                                 (*  the size of a tile  *)
  43.                                 Size         : COORDS_TYPE;
  44.                 Origin        : COORDS_TYPE;
  45.                                 NumMines     : BYTE;
  46.                                 TimeLimit     : WORD;   (* in secs *)
  47.             END;
  48.  
  49.         (*  the coordinates of a hexagon  *)
  50.     HEXAGON_TYPE  = ARRAY [1..6] OF COORDS_TYPE;
  51.     (*  top, topleft, topright, middle, bottomleft, bottomright, bottom *)
  52.     SEGMENT_TYPE  = (t, tl, tr, m, bl, br, b);
  53.         (*  the tile_type defines the tiles' appearance  *)
  54.         TILE_TYPE      = RECORD
  55.                                 Size            : COORDS_TYPE;
  56.                                 inner_min      : COORDS_TYPE;
  57.                 inner_max      : COORDS_TYPE;
  58.                                 Seg_Coords        : ARRAY [SEGMENT_TYPE] OF HEXAGON_TYPE;
  59.                 END;
  60.  
  61.     COL_ROW_TYPE   = -2..(MAX_COL_ROW + 2);  (* ±2 for the exploding mines *)
  62.  
  63. CONST   HIDDEN          = [hidden0 .. hidden_mine];
  64.         VISIBLE         = [visible0.. visible_mine];
  65.         MARKED          = [marked0 .. marked_mine];
  66.  
  67. VAR     TileImage     : ARRAY  [PUSH_MODE_TYPE]  OF  POINTER;
  68.  
  69. (*  the supplied procedures  *)
  70.  
  71. (*  get_tile_pos returns the position of tile (col,row) in scene  *)
  72. PROCEDURE    get_tile_pos(VAR  scene       : SCENE_TYPE;
  73.                   col, row : COL_ROW_TYPE;
  74.                  VAR  x, y     : WORD);
  75. (*  get_tile_middle returns the middle of tile (col,row) in scene  *)
  76. PROCEDURE    get_tile_middle(VAR  scene    : SCENE_TYPE;
  77.                      col, row : COL_ROW_TYPE;
  78.                     VAR  x, y     : WORD);
  79.  
  80. (*  draw_contents draws the tile's contents *)
  81. PROCEDURE       draw_contents(VAR   tile : TILE_TYPE;
  82.                         x, y : WORD;
  83.                            contents : CONTENTS_TYPE;
  84.                   color     : COLOR_TYPE);
  85.  
  86. (*  draw_tile draws one tile with contents in scene, col, row  *)
  87. (*  scene is given as VAR to speed things up a little ...  *)
  88. PROCEDURE       draw_tile(VAR   scene    : SCENE_TYPE;
  89.               VAR    tile     : TILE_TYPE;
  90.                            col, row : COL_ROW_TYPE;
  91.                            contents : CONTENTS_TYPE);
  92.  
  93. (*  generate_tile computes tile's size and generates its graphics *)
  94. (*  it draws a tile on the screen, screen should be dimmer before call
  95.     and cleared up after call  *)
  96. PROCEDURE    generate_tile(scene : SCENE_TYPE; VAR tile : TILE_TYPE);
  97.  
  98. IMPLEMENTATION
  99.  
  100. USES GRAPH;
  101.  
  102. TYPE    DIGIT_TYPE     = SET OF SEGMENT_TYPE;
  103.  
  104.         (*  the segments to be illuminated for each symbol  *)
  105.         (*  note that only 1..8 are needed for the playfield, 0 and 9 are
  106.         included to enable display every number (e.g. the time)  *)
  107. CONST   DIGIT : ARRAY [visible0..marked0] OF DIGIT_TYPE =
  108.             (  [t, tl, tr, bl, br, b],       (* 0 *)
  109.            [tr, br],            (* 1 *)
  110.            [t, tr, m, bl, b],          (* 2 *)
  111.            [t, tr, m, br, b],        (* 3 *)
  112.            [tl, tr, m, br],          (* 4 *)
  113.            [t, tl, m, br, b],        (* 5 *)
  114.            [t, tl, m, bl, br, b],      (* 6 *)
  115.            [t, tr, br],            (* 7 *)
  116.                    [t, tl, tr, m, bl, br, b],   (* 8 *)
  117.                    [t, tl, tr, m, br, b],       (* 9 *)
  118.                    [tl, m, bl, br, b],          (* b *)  (*  visible_mine  *)
  119.                    [t, tl, m, bl]               (* F *)  (*  marked0 = Flag  *)
  120.                 );
  121.  
  122.     ORIGINAL_TILE    : TILE_TYPE =
  123.             ( Size: (x: 100;  y: 100);
  124.            inner_min: (x: 10;  y: 10);
  125.            inner_max: (x: 89;  y: 89);
  126.            Seg_Coords: (((x: 33; y: 29), (x: 28; y: 24), (x: 33; y: 19),
  127.                         (x: 66; y: 19), (x: 71; y: 24), (x: 66; y: 29)),  (* t  *)
  128.             ((x: 30; y: 31), (x: 25; y: 26), (x: 20; y: 31),
  129.                      (x: 20; y: 42), (x: 25; y: 47), (x: 30; y: 42)),  (* tl *)
  130.                ((x: 79; y: 31), (x: 74; y: 26), (x: 69; y: 31),
  131.                      (x: 69; y: 42), (x: 74; y: 47), (x: 79; y: 42)),  (* tr *)
  132.                         ((x: 33; y: 54), (x: 28; y: 49), (x: 33; y: 44),
  133.                      (x: 66; y: 44), (x: 71; y: 49), (x: 66; y: 54)),  (* m  *)
  134.                ((x: 30; y: 56), (x: 25; y: 51), (x: 20; y: 56),
  135.                      (x: 20; y: 67), (x: 25; y: 72), (x: 30; y: 67)),  (* bl *)
  136.                ((x: 79; y: 56), (x: 74; y: 51), (x: 69; y: 56),
  137.                         (x: 69; y: 67), (x: 74; y: 72), (x: 79; y: 67)),  (* br *)
  138.                         ((x: 33; y: 80), (x: 28; y: 75), (x: 33; y: 70),
  139.                      (x: 66; y: 70), (x: 71; y: 75), (x: 66; y: 80)) ) (* b  *)
  140.          );
  141.  
  142.  
  143. (*  get_tile_pos returns the position of tile (col,row) in scene  *)
  144. PROCEDURE    get_tile_pos(VAR  scene       : SCENE_TYPE;
  145.                   col, row : COL_ROW_TYPE;
  146.                  VAR  x, y     : WORD);
  147. BEGIN
  148.     x := scene.Origin.x + SUCC(scene.Size.x) * col;
  149.     y := scene.Origin.y + SUCC(scene.Size.y) * row;
  150. END;    (*  get_tile_pos  *)
  151.  
  152.  
  153. (*  get_tile_middle returns the middle of tile (col,row) in scene  *)
  154. PROCEDURE    get_tile_middle(VAR  scene    : SCENE_TYPE;
  155.                      col, row : COL_ROW_TYPE;
  156.                     VAR  x, y     : WORD);
  157. BEGIN
  158.         get_tile_pos(scene, col, row, x, y);
  159.         INC(x, scene.Size.x DIV 2);
  160.         INC(y, scene.Size.y DIV 2);
  161. END;    (*  get_tile_middle  *)
  162.  
  163.  
  164. (*  draw_contents draws the tile's contents *)
  165. PROCEDURE       draw_contents(VAR   tile : TILE_TYPE;
  166.                         x, y : WORD;
  167.                            contents : CONTENTS_TYPE;
  168.                   color     : COLOR_TYPE);
  169. VAR    seg    : SEGMENT_TYPE;
  170.     hexagon : HEXAGON_TYPE;
  171.     hp    : 1..6;
  172. BEGIN
  173.         IF  (color = BY_CONTENTS)  THEN
  174.         BEGIN      (*  draw on field, setcolor according to tile contents *)
  175.                 CASE  contents  OF
  176.                    marked0     : color := CLR_MARKED;
  177.                    visible_mine    : color := CLR_VISIBLE_MINE;
  178.                    ELSE          color := CLR_VISIBLE1 + ORD(contents)
  179.                                     - ORD(visible1);
  180.                 END;  (* CASE *)
  181.         END  (* IF *)
  182.         ELSE
  183.         BEGIN
  184.             SetFillStyle(SOLIDFILL, GREY);
  185.                 Bar(x + tile.inner_min.x, y + tile.inner_min.y,
  186.                     x + tile.inner_max.x, y + tile.inner_max.y);
  187.         END;  (* ELSE *)
  188.  
  189.         SetColor(color);      SetFillStyle(SOLIDFILL, color);
  190.         SetViewPort(x, y, x+tile.Size.x , y+tile.Size.y, ClipOFF);
  191.  
  192.     FOR seg := t  TO  b  DO
  193.                 IF  (seg IN DIGIT[contents])  THEN
  194.                     FillPoly(6, tile.Seg_COORDS[seg]);
  195.  
  196.         SetViewPort(0, 0, GetMaxX, GetMaxY, ClipOFF);
  197. END;    (*  draw_contents  *)
  198.  
  199.  
  200. (*  draw_tile draws one tile with contents in scene, col, row  *)
  201. (*  scene and tile are given as VAR to speed things up a little ...  *)
  202. (*  in MP-look the VISIBLE0s are drawn by "uncover_hidden0s()",
  203.     in PL-look they are drawn by draw_tile, just like any other tile,
  204.     except for the missing symbol  *)
  205.  
  206. PROCEDURE       draw_tile(VAR   scene    : SCENE_TYPE;
  207.               VAR    tile     : TILE_TYPE;
  208.                            col, row : COL_ROW_TYPE;
  209.                            contents : CONTENTS_TYPE);
  210.  
  211. VAR    x, y    : WORD;
  212. BEGIN
  213.         get_tile_pos(scene, col, row, x, y);
  214.         IF  (contents IN HIDDEN)  THEN
  215.         PutImage(x, y, TileImage[NOT_PUSHED_TILE]^, NORMALPUT)
  216.         ELSE IF  (contents IN VISIBLE + MARKED)  THEN
  217.         BEGIN
  218.                 (*  the marked0 is the only MARKED tile that has
  219.             a symbol and color  *)
  220.                 IF  (contents IN MARKED)  THEN  contents := marked0;
  221.  
  222.         (*  don't PUSH a MARKED tile, just the VISIBLE ones  *)
  223.                 (*  NOTE: PUSHED_TILE = TRUE, therefore the tile is pushed
  224.                           if contents is in VISIBLE  *)
  225.         PutImage(x, y, TileImage[contents in VISIBLE]^, NORMALPUT);
  226.  
  227.                 (*  in PL-look: no symbol for VISIBLE0  *)
  228.                 IF (contents <> VISIBLE0)  THEN
  229.             draw_contents(tile, x, y, contents, BY_CONTENTS);
  230.         END;  (* ELSE IF *)
  231. END;    (*  draw_tile  *)
  232.  
  233.  
  234. (*  generate_tile computes tile's size and generates its graphics *)
  235. (*  it draws a tile on the screen, screen should be dimmed before call
  236.     and cleared up after call  *)
  237. PROCEDURE    generate_tile(scene : SCENE_TYPE; VAR tile : TILE_TYPE);
  238.  
  239. (*  adjust_tile  returns a tile adjusted according to the size of the scene  *)
  240. PROCEDURE       adjust_tile (scene     : SCENE_TYPE;
  241.                  original    : TILE_TYPE;
  242.              VAR adjusted     : TILE_TYPE);
  243. VAR     p           : BYTE;
  244.         seg         : SEGMENT_TYPE;
  245.  
  246. PROCEDURE       adjust_coords (VAR coord : COORDS_TYPE);
  247. BEGIN
  248.         coord.x := (coord.x * adjusted.Size.x + original.Size.x DIV 2) DIV original.Size.x;
  249.         coord.y := (coord.y * adjusted.Size.y + original.Size.y DIV 2) DIV original.Size.y;
  250. END;    (*  adjust_coords  *)
  251.  
  252. BEGIN
  253.         adjusted := original;    (*  copy the original settings  *)
  254.         adjusted.Size := scene.Size;
  255.  
  256.         (*  adjust inner area  *)
  257.         adjust_coords(adjusted.inner_min);
  258.         adjust_coords(adjusted.inner_max);
  259.  
  260.         (*  adjust segment positions for all the segments *)
  261.         FOR seg :=  t  TO  b  DO
  262.             (*  adjust the 6 segment vertices  *)
  263.             FOR p := 1 TO 6 DO
  264.                         adjust_coords(adjusted.Seg_COORDS[seg][p]);
  265. END;    (*  adjust_tile  *)
  266.  
  267. VAR    Triangle     : ARRAY[1..3] OF COORDS_TYPE;
  268. BEGIN
  269.         (*  compute tile's size  *)
  270.         adjust_tile(scene, ORIGINAL_TILE, tile);
  271.  
  272.     Triangle[1].x := 0;            Triangle[1].y := 0;
  273.         Triangle[2].x := PRED(tile.Size.x);    Triangle[2].y := 0;
  274.         Triangle[3].y := PRED(tile.Size.y);    Triangle[3].x := 0;
  275.  
  276.    (*  generate graphics for pushed tile *)
  277.       SetFillStyle(SolidFill, WHITE);
  278.     Bar(0, 0, PRED(tile.Size.x), PRED(tile.Size.y));
  279.         SetColor(DKGREY);  SetFillStyle(SolidFill, DKGREY);
  280.         FillPoly(3, Triangle);
  281.     SetFillStyle(SolidFill, GREY);
  282.     Bar(tile.inner_min.x, tile.inner_min.y, tile.inner_max.x, tile.inner_max.y);
  283.      SetColor(GREY);
  284.     Line(PRED(tile.Size.x), PRED(tile.Size.Y), tile.inner_max.x, tile.inner_max.y);
  285.         GetImage(0,0, PRED(tile.Size.x), PRED(tile.Size.y), TileImage[PUSHED_TILE]^);
  286.  
  287.    (*  generate graphics for not pushed tile *)
  288.         SetFillStyle(SolidFill, DKGREY);
  289.     Bar(0, 0, PRED(tile.Size.x), PRED(tile.Size.y));
  290.         SetColor(WHITE);  SetFillStyle(SolidFill, WHITE);
  291.         FillPoly(3, Triangle);
  292.     SetFillStyle(SolidFill, GREY);
  293.     Bar(tile.inner_min.x, tile.inner_min.y, tile.inner_max.x, tile.inner_max.y);
  294.      SetColor(GREY);
  295.     Line(0, 0, tile.inner_min.x, tile.inner_min.y);
  296.         GetImage(0,0, PRED(tile.Size.x), PRED(tile.Size.y), TileImage[NOT_PUSHED_TILE]^);
  297.  
  298. END;    (*  generate_tile  *)
  299.  
  300. END.    (*  UNIT TILES  *)